Optional tilemap-display.f

{
TO DO:
  Need to code backup plan for when there's no VBO support.

Tiles are grabbed from the current texture which is treated as a 2048x2048 "texturebank",
containing 64 256x256 "sections".

A tileset can span up to 8 sections vertically, because they are treated as 2d arrays that are 32 8x8 tiles wide,
adding up to 8192 max tiles per tileset.

Maps can be any width or height.  The tile entries follow this 16-bit format:
  VH?TTTTTTTTTTTTT
  where bits 0-12 (T) are the tile index (0-8191) - there are a maximum of 8192 tiles per tileset because of the texture bank height.
  and VH allow tiles to be flipped vertically and/or horizontally.
  ? is reserved.  could be potentially used in a RLE scheme, but right now I won't be using that.

map arrays are stored in rows

}

Requires OpenGL
Requires Seki
Requires OpenGL\ARB-VBO
Requires GL-Tools
Requires Vectors
Requires SORA\Texturebanks
Requires SORA\Drawing

Requires A
Requires Tools

Only Forth Definitions


\ version using SHORT's
-? : quad!a+' ( x y -- )
  over w!a+ dup w!a+
  over 1+ w!a+ dup w!a+
  over 1+ w!a+ dup 1+ w!a+
  swap w!a+ 1+ w!a+
  ;


: tc!a+   swap w!a+ w!a+ ;

\ generate texture coords for a tile in a texture bank section.
: tlocate ( tile -- x y )
  dup %11111 and swap %1111111111100000 and 5 rshift ;

\ implement the 4 tile flipping styles
: tiletex ( tile  -- )
  tlocate 2dup tc!a+ 2dup 1 0 2+ tc!a+ 2dup 1 1 2+ tc!a+ 1 + tc!a+ ;

: tiletex-h (  tile -- )
  tlocate 2dup 1 0 2+ tc!a+ 2dup tc!a+ 2dup 1 + tc!a+ 1 1 2+ tc!a+ ;

: tiletex-v (  tile -- )
  tlocate 2dup 1 + tc!a+ 2dup 1 1 2+ tc!a+ 2dup 1 0 2+ tc!a+ tc!a+ ;

: tiletex-hv (  tile -- )
  tlocate 2dup 1 1 2+ tc!a+ 2dup 1 + tc!a+ 2dup tc!a+ 1 0 2+ tc!a+ ;

create tile-routines   ' tiletex >code , ' tiletex-h >code , ' tiletex-v >code , ' tiletex-hv >code ,

: parse-tile ( val -- )
  dup 14 rshift cells tile-routines + @ call ;

\ create tile-verts 8 cells 129 * /allot
create tile-tcoords 8 cells 140 * /allot  \ has a bit of safe zone

0 value tile-verts
\ 0 value tile-tcoords

variable vbo
variable vbo-t

: init-tilemap-display
  glGenBuffersARB( 1 vbo )
  vbo @ bind-vbo
  glBufferDataARB( GL_ARRAY_BUFFER_ARB  8 cells 129 *   0 GL_STATIC_DRAW_ARB )
  glMapBufferARB( GL_ARRAY_BUFFER_ARB GL_WRITE_ONLY_ARB ) to tile-verts

  tile-verts a!
  129 0  do    i 0 quad!a+'    1 +loop
  begin glUnmapBufferARB( GL_ARRAY_BUFFER_ARB ) until
  ;

8 value (tilew)
8 value (tileh)
: draw-tilemap ( addr map-w cols rows -- )
   locals| rows cols map-w |
   gl-texture gl-enable

   glDisableClientState( GL_COLOR_ARRAY )
   glDisableClientState( GL_NORMAL_ARRAY )

   unbind-vbo
   glTexCoordPointer( 2 GL_SHORT 0 tile-tcoords )
   glEnableClientState( GL_TEXTURE_COORD_ARRAY )

   vbo @ bind-vbo
   \ glVertexPointer( 2 GL_FLOAT 0 0 )
   glVertexPointer( 2 GL_SHORT 0 0 )
   glEnableClientState( GL_VERTEX_ARRAY )

   push-modelview
   glTranslatef( @pen 2s>f 0e )
   (tilew) s>f (tileh) s>f 1e glScalef
   rows 0 do  ( addr )
      dup
         tile-tcoords a!  cols 0 do   w@+  parse-tile  loop
      drop  map-w 2* +
      glDrawArrays( GL_QUADS  0  cols 4 * )
      modelview matrix glTranslatef( 0e 1e 0e )
   loop    drop
   pop-modelview ;

: tilemap-tile-size  ( w h -- )
   to (tileh) to (tilew) ;
